home *** CD-ROM | disk | FTP | other *** search
/ Gigarom 4 / Mac Giga-ROM 4.0 - 1993.toast / FILES / HYP / E-G / Fractal3.cpt / fractal2.a < prev    next >
Text File  |  1989-02-26  |  12KB  |  461 lines
  1. ;
  2. ;    fractal xcmd v0.3 -- Doug Felt, Oct 14, 1987
  3. ;    
  4. ;    This draws a fractal on the screen.  Not to the card, yet.  Function is
  5. ;    f(z) = z * z + c, julia set mapped to 4 patterns.
  6. ;    
  7. ;    Format:
  8. ;         Fractal seed.h seed.v [res = 8 [limit = 32 [lock = 0]]]
  9. ;         
  10. ;    seed is the complex constant c (v imaginary)
  11. ;    res is the number of pixels on a side for the point to plot 
  12. ;    limit is the max number of iterations (best between 16 & 128, multiple of 4),
  13. ;    lower limit means most complex regions of the fractal are white
  14. ;    if lock is 0, pressing the mouse will immediately stop the drawing, otherwise
  15. ;    pressing the mouse has no effect and drawing can only be stopped by reboot or
  16. ;    fancy macsbug work.
  17. ;   
  18. ;    Doug Felt, AIR/CAT Project
  19. ;    duggie@jessica.stanford.edu
  20. ;
  21. ;    
  22. ;    To compile and link in MPW C:
  23. ;
  24. ;    C -q2 Fractal.c
  25. ;    link -sn Main=Fractal -sn STDIO=Fractal ∂
  26. ;         -sn INTENV=Fractal -rt XCMD=104 ∂
  27. ;         -m FRACTAL Fractal.c.o "{CLibraries}CRunTime.o" ∂
  28. ;         -o HyperCommands
  29. ;
  30. ;
  31. ;        Well now, I thought this was so neat, and Doug was right it needs a 
  32. ;    little more speed. So thats what I did, I rewrote the "C" program in 
  33. ;    assembler with direct processing on the MC68881 FPU. I think this makes
  34. ;    quite a difference. The only thing is that it only runs on a MacII. It
  35. ;    might run on one or more of the accelerator cards. Give it a try. If 
  36. ;    necessary, change the COID= parameter below if they are using other than 1.
  37. ;
  38. ;                    Ray Sanders
  39. ;                Green Grass Software, Inc.
  40. ;
  41. ;            CIS: 70277,3233     GEnie: RAYSANDERS
  42. ;
  43. ;    To assemble and link with MPW:
  44. ;
  45. ;                fractal2.a.o ƒ fractal2.make fractal2.a
  46. ;                    Asm fractal2.a -l -font Monaco,9
  47. ;                fractal2 ƒ fractal2.make fractal2.a.o
  48. ;                    link -o fractal2 -rt XCMD=105 -sn Main=Fractal2 -t STAK -c WILD ∂
  49. ;                        fractal2.a.o ∂
  50. ;                        -o "Fractals"
  51. ;
  52. ;
  53. fractal2    MAIN
  54.         
  55.         BLANKS        ON
  56.         STRING        ASIS
  57.         MC68881        COID=1,PREC=X,ROUND=N
  58. ;         INCLUDE        'Traps.a'
  59. ;         INCLUDE        'SysEqu.a'
  60.         PRINT        OFF
  61.          INCLUDE        'Traps.a'
  62.          INCLUDE        'SysEqu.a'
  63.         PRINT        ON,NOWARN
  64. ;        PRINT        ON
  65.  
  66.  
  67. ; HyperCard data structure offsets
  68.  
  69. XCmdParamCount    EQU        0                ;number of parameters
  70. XCmdParams        EQU        2                ;16 handles to C-strings
  71. XCmdReturnVal    EQU        66                ;handle to return string
  72. XCmdPassFlag    EQU        70                ;boolean, to pass message through
  73. XCmdEntryPoint    EQU        72                ;hyperCard call-back
  74. XCmdRequest        EQU        76                ;call back opcode field
  75. XCmdResult        EQU        78                ;call back result field
  76. XCmdInArgs        EQU        80                ;8 longs, input arguments
  77. XCmdOutArgs        EQU        112                ;4 longs, output arguments
  78.  
  79. MenuList        EQU        $A1C
  80.  
  81. ;    result codes
  82.  
  83. xresSucc             EQU        0
  84. xresFail             EQU        1 
  85. xresNotImp             EQU        2 
  86.  
  87. ;    request codes
  88.  
  89. xreqSendCardMessage        EQU        1 
  90. xreqEvalExpr            EQU        2 
  91. xreqStringLength        EQU        3 
  92. xreqStringMatch            EQU        4 
  93. xreqSendHCMessage        EQU        5
  94. xreqZeroBytes             EQU        6 
  95. xreqPasToZero            EQU        7 
  96. xreqZeroToPas            EQU        8 
  97. xreqStrToLong            EQU        9 
  98. xreqStrToNum            EQU        10 
  99. xreqStrToBool            EQU        11 
  100. xreqStrToExt            EQU        12 
  101. xreqLongToStr            EQU        13 
  102. xreqNumToStr            EQU        14 
  103. xreqNumToHex            EQU        15 
  104. xreqBoolToStr            EQU        16 
  105. xreqExtToStr            EQU        17 
  106. xreqGetGlobal            EQU        18 
  107. xreqSetGlobal            EQU        19 
  108. xreqGetFieldByName        EQU        20 
  109. xreqGetFieldByNum        EQU        21 
  110. xreqGetFieldByID        EQU        22 
  111. xreqSetFieldByName        EQU        23 
  112. xreqSetFieldByNum        EQU        24 
  113. xreqSetFieldByID        EQU        25 
  114. xreqStringEqual           EQU        26 
  115. xreqReturnToPas           EQU        27 
  116. xreqScanToReturn          EQU        28 
  117. xreqScanToZero            EQU        39   ;    was suppose to be 29!  Oops!
  118.  
  119.  
  120. ; definition of stack frame
  121.  
  122. stackStor    RECORD    0,DECREMENT
  123. stackStorStart    EQU        *
  124. xcmdBlockAddr    DS.L    1
  125. noLock            DS.W    1
  126. res                DS.W    1
  127. hsize            DS.W    1
  128. vsize            DS.W    1
  129. i                DS.W    1
  130. j                DS.W    1
  131. iter            DS.W    1
  132. limit            DS.W    1
  133. rbaseh            DS.W    1
  134. rat                DS.L    3
  135. seedh            DS.L    3
  136. seedv            DS.L    3
  137. valh            DS.L    3
  138. valv            DS.L    3
  139. temp            DS.L    3
  140. basev            DS.L    3
  141. baseh            DS.L    3
  142. hsq                DS.L    3
  143. vsq                DS.L    3
  144. real2            DS.L    3
  145. realn2            DS.L    3
  146. real100            DS.L    3
  147. fake256            DS.L    1
  148. fake171            DS.L    1
  149. fake2            DS.L    1
  150. fake100            DS.L    1
  151. r                DS.W    4
  152. pats            DS.L    8
  153. tempX            DS.L    3
  154. tempStr            DS.B    256
  155. tempL            DS.L    1
  156. stackStorLen    EQU     *-stackStorStart 
  157.             ENDR
  158.  
  159.             WITH stackStor
  160. EntryPoint
  161. ;;;        _Debugger                            ;
  162.         LINK    A6,#stackStorLen            ;
  163.         MOVEM.L    A0-A6/D0-D7,-(SP)            ;
  164.     
  165.         MOVE.L    8(A6),A3                    ;
  166.         MOVE.L    A3,xcmdBlockAddr(A6)        ;
  167.         
  168.         CMPI.W    #3,XCmdParamCount(A3)        ; if (paramPtr->paramCount<2) return
  169.         BLT        FracsDone                    ;
  170.         
  171.         MOVE.L    #$00000000,pats(A6)            ; pats[0].long1 = 0
  172.         MOVE.L    #$00000000,pats+4(A6)        ; pats[0].long2 = 0
  173.         MOVE.L    #$AA005500,pats+8(A6)        ; pats[1].long1 = 0xaa005500
  174.         MOVE.L    #$AA005500,pats+12(A6)        ; pats[1].long2 = 0xaa005500
  175.         MOVE.L    #$55FFAAFF,pats+16(A6)        ; pats[2].long1 = 0x55ffaaff
  176.         MOVE.L    #$55FFAAFF,pats+20(A6)        ; pats[2].long2 = 0x55ffaaff
  177.         MOVE.L    #$FFFFFFFF,pats+24(A6)        ; pats[3].long1 = 0xffffffff
  178.         MOVE.L    #$FFFFFFFF,pats+28(A6)        ; pats[3].long2 = 0xffffffff
  179.         
  180.         MOVE.W    #8,res(A6)                    ; res = 8
  181.         
  182.         MOVE.W    #32,limit(A6)                ; limit = 32
  183.         
  184.         MOVE.W    #1,nolock(A6)                ; nolock = 1
  185.  
  186.         MOVE.L    XCmdParams(A3),-(SP)        ; seedh = ParamToExt(paramPtr,0)
  187.         PEA.L    seedh(A6)                    ;
  188.         BSR        ZeroToExt                    ;
  189.         ADDQ.L    #8,SP                        ;
  190.         
  191.         MOVE.L    XCmdParams+4(A3),-(SP)        ; seedv = ParamToExt(paramPtr,1)
  192.         PEA.L    seedv(A6)                    ;
  193.         BSR        ZeroToExt                    ;
  194.         ADDQ.L    #8,SP                        ;
  195.  
  196.         CMPI.W    #3,XCmdParamCount(A3)        ; if (paramPtr->paramCount>2)
  197.         BLT        @150                        ;
  198.         MOVE.L    XCmdParams+8(A3),-(SP)        ; res = ParamToNum(paramPtr,2)
  199.         PEA.L    tempL(A6)                    ;
  200.         BSR        ZeroToNum                    ;
  201.         ADDQ.L    #8,SP                        ;
  202.         MOVE.W    tempL+2(A6),res(A6)            ;
  203.         
  204.         CMPI.W    #0,res(A6)                    ; if (res <= 0)
  205.         BGT.S    @110                        ; 
  206.         MOVE.W    #1,res(A6)                    ;     res = 1
  207. @110
  208.  
  209.         CMPI.W    #4,XCmdParamCount(A3)        ; if (paramPtr->paramCount>3)
  210.         BLT        @150                        ;
  211.         MOVE.L    XCmdParams+12(A3),-(SP)        ; limit = ParamToNum(paramPtr,3)
  212.         PEA.L    tempL(A6)                    ;
  213.         BSR        ZeroToNum                    ;
  214.         ADDQ.L    #8,SP                        ;
  215.         MOVE.W    tempL+2(A6),limit(A6)        ;
  216.         
  217.         CMPI.W    #3,limit(A6)                ; if (limit<4) 
  218.         BGT.S    @120                        ;
  219.         MOVE.W    #4,limit(A6)                ;     limit = 4
  220. @120
  221.  
  222.         CMPI.W    #5,XCmdParamCount(A3)        ; if (paramPtr->paramCount>4)
  223.         BLT        @150                        ;
  224.         MOVE.L    XCmdParams+16(A3),-(SP)        ; nolock = !ParamToNum(paramPtr,4)
  225.         PEA.L    tempL(A6)                    ;
  226.         BSR        ZeroToNum                    ;
  227.         ADDQ.L    #8,SP                        ;
  228.         MOVE.W    tempL+2(A6),nolock(A6)        ;
  229.         NOT.W    nolock(A6)                    ;
  230. @150
  231.  
  232. ;    /* map screen onto -2 to 2 range */
  233. ;    
  234. ;    /* 0,0 is at 512/2, 342/2 = 256,171 */
  235. ;    
  236. ;    /* gridding to res requires that I find out how many boxes wide and tall
  237. ;       the image is, and map each box onto a value in r2.  then i iterate over
  238. ;       all the boxes calling the function until the x or y exceeds some limit.
  239. ;       then i map the number of iterations into a 'color' */
  240. ;       
  241. ;    /* since we don't have a global data area for extended constants to live in,
  242. ;       use longs and fake the compiler into making the correct SANE calls to 
  243. ;       build the extended values.  Is there a better way (besides using Pascal!) */
  244. ;
  245.         MOVE.L    #256,fake256(A6)            ; fake256 = 256
  246.         
  247.         MOVE.L    #171,fake171(A6)            ; fake171 = 171
  248.         
  249.         MOVE.L    #2,fake2(A6)                ; fake2 = 2
  250.         
  251.         MOVE.L    #100,fake100(A6)            ; fake100 = 100
  252.  
  253.         MOVE.L    #256,D0                        ; hsize = (fake256/res)+1
  254.         DIVS.W    res(A6),D0                    ;
  255.         ADDQ.W    #1,D0                        ;
  256.         MOVE.W    D0,hsize(A6)                ;
  257.         
  258.         MOVE.L    #171,D0                        ; vsize = (fake171/res)+1
  259.         DIVS.W    res(A6),D0                    ;
  260.         ADDQ.W    #1,D0                        ;
  261.         MOVE.W    D0,vsize(A6)                ;
  262.         
  263.         FMOVECR.X #$34,FP0                    ; real100 = fake100
  264.         FMOVE.X    FP0,real100(A6)                ;
  265.         
  266.         FMOVE.W    #2,FP0                        ; real2 = fake2
  267.         FMOVE.X    FP0,real2(A6)                ;
  268.         
  269.         FMOVE.W    #-2,FP0                        ; realn2 = -fake2
  270.         FMOVE.X    FP0,realn2(A6)                ;
  271.         
  272.         FMOVE.X    real2(A6),FP0                ; rat = real2/hsize
  273.         FDIV.W    hsize(A6),FP0                ;
  274.         FMOVE.X    FP0,rat(A6)                    ; /* reals intermediate result because of real2 */
  275.         
  276.         MOVE.W    res(A6),D0                    ; rbaseh = 256-hsize*res
  277.         MULS.W    hsize(A6),D0                ;
  278.         MOVE.W    #256,D1                        ;
  279.         SUB.W    D0,D1                        ;
  280.         MOVE.W    D1,rbaseh(A6)                ;
  281.         
  282.         MOVE.W    res(A6),D0                    ; r.top = 171-vsize*res
  283.         MULS.W    vsize(A6),D0                ;
  284.         MOVE.W    #171,D1                        ;
  285.         SUB.W    D0,D1                        ;
  286.         MOVE.W    D1,r(A6)                    ;
  287.         
  288.         ADD.W    res(A6),D1                    ; r.bottom = r.top + res
  289.         MOVE.W    D1,r+4(A6)                    ;
  290.         
  291.         FMOVE.L    fake171(A6),FP2                ; basev = realn2*fake171/fake256
  292.         FMUL.X    realn2(A6),FP2                ; /* center it */
  293.         FDIV.L    fake256(A6),FP2                ;
  294.         
  295.         FMOVE.X    seedv(A6),FP0                ;
  296.         FMOVE.X    seedh(A6),FP1                ;
  297.  
  298. ;            for loop
  299.         
  300.         MOVE.W    vsize(A6),D4                ; for (i=-vsize; i<vsize; ++i)
  301.         NEG.W    D4                            ;
  302. @200
  303.         CMP.W    vsize(A6),D4                ;
  304.         BGE        @500                        ;
  305.         
  306.         MOVE.W    rbaseh(A6),D0                ; r.left = rbaseh
  307.         MOVE.W    D0,r+2(A6)                    ;
  308.         
  309.         ADD.W    res(A6),D0                    ; r.right = r.left + res
  310.         MOVE.W    D0,r+6(A6)                    ;
  311.         
  312.         FMOVE.X    realn2(A6),FP3                ; baseh = realn2
  313.         
  314. ;            for loop
  315.  
  316.         MOVE.W    hsize(A6),D3                ; for (j=-hsize; j<hsize; ++j)
  317.         NEG.W    D3                            ;
  318. @250
  319.         CMP.W    hsize(A6),D3                ;
  320.         BGE        @450                        ;
  321.         
  322.         FMOVE.X    FP3,FP5                        ; valh = baseh
  323.         
  324.         FMOVE.X    FP2,FP4                        ; valv = basev
  325.         
  326.         CLR.W    D5                            ; iter = 0
  327.         
  328. ;            do loop
  329.  
  330. @300
  331. ;
  332. ;
  333. ;    register assignments to speed up loop
  334. ;
  335. ;        hsq is in FP7
  336. ;        vsq is in FP6
  337. ;        valh is in FP5
  338. ;        valv is in FP4
  339. ;        baseh is in FP3
  340. ;        basev is in FP2
  341. ;        seedh is in FP1
  342. ;        seedv is in FP0
  343. ;
  344.         
  345.         FMOVE.X    FP4,FP6                        ; vsq = valv * valv
  346.         FMUL.X    FP4,FP6                        ;
  347.         
  348.         FMUL.X    FP5,FP4                        ; valv = real2*valh*valv + seedv
  349.         FADD.X    FP4,FP4                        ;
  350.         FADD.X    FP0,FP4                        ;
  351.         
  352.         FMUL.X    FP5,FP5                        ; hsq = valh * valh
  353.         FMOVE.X    FP5,FP7                        ;
  354.         
  355.         FSUB.X    FP6,FP5                        ; valh = hsq - vsq + seedh
  356.         FADD.X    FP1,FP5                        ;
  357.         
  358.         ADDQ.W    #1,D5                        ; ++iter
  359.         
  360.         FADD.X    FP6,FP7                        ; while ((hsq+vsq<real100) && (iter<limit))
  361.         FMOVECR.X #$34,FP6                    ;
  362.         FCMP.X    FP7,FP6                        ;
  363.         FBLE.W    @350                        ;
  364.         CMP.W    limit(A6),D5                ;
  365.         BLE        @300                        ;
  366.  
  367. @350
  368.         FADD.X    rat(A6),FP3                    ; baseh += rat
  369.         
  370.         ANDI.W    #3,D5                        ; PenPat(&pats[iter & 0x03])
  371.         LSL.W    #3,D5                        ;
  372.         LEA.L    pats(A6),A0                    ;
  373.         ADDA.W    D5,A0                        ;
  374.         MOVE.L    A0,-(SP)                    ;
  375.         _PenPat                                ;
  376.         
  377.         PEA.L    r(A6)                        ; PaintRect(&r)
  378.         _PaintRect                            ;
  379.         
  380.         MOVE.W    res(A6),D0                    ; r.left += res
  381.         ADD.W    D0,r+2(A6)                    ;
  382.         
  383.         ADD.W    D0,r+6(A6)                    ; r.right += res
  384.         
  385.         ADDQ.W    #1,D3                        ;
  386.         BRA        @250                        ;
  387.  
  388. @450
  389.  
  390.         FADD.X    rat(A6),FP2                    ; basev += rat
  391.         
  392.         MOVE.W    res(A6),D0                    ; r.top += res
  393.         ADD.W    D0,r(A6)                    ;
  394.         
  395.         ADD.W    D0,r+4(A6)                    ; r.bottom += res
  396.         
  397.         TST.W    nolock(A6)                    ; if (nolock && Button()) return
  398.         BEQ.S    @475                        ;
  399.         CLR.W    -(SP)                        ;
  400.         _Button                                ;
  401.         TST.W    (SP)+                        ;
  402.         BNE        FracsDone                    ;
  403. @475
  404.         
  405.         ADDQ.W    #1,D4                        ;
  406.         BRA        @200                        ;
  407.  
  408. @500
  409. FracsDone
  410.         MOVEM.L    (SP)+,A0-A6/D0-D7        ; restore registers
  411.         UNLK    A6
  412.         MOVE.L    (SP)+,(SP)
  413.         RTS
  414.  
  415. ZeroToNum
  416.         MOVE.L    xcmdBlockAddr(A6),A3    ; xcmd blk ptr
  417.         MOVE.L    8(SP),A0                ; handle to num string
  418.         MOVE.L    (A0),XCmdInArgs(A3)        ; ptr to num string
  419.         LEA.L    tempStr(A6),A0            ; pt to temp string area
  420.         MOVE.L    A0,XCmdInArgs+4(A3)        ; set temp string ptr
  421.         MOVE.W    #xreqZeroToPas,XCmdRequest(A3) ; convert to pascal string
  422.         MOVE.L    XCmdEntryPoint(A3),A0    ; get entry point addr
  423.         JSR        (A0)                    ; call HC
  424.         LEA.L    tempStr(A6),A0            ; pt to temp string area
  425.         MOVE.L    A0,XCmdInArgs(A3)        ; set first arg
  426.         MOVE.W    #xreqStrToNum,XCmdRequest(A3) ; set req code
  427.         MOVE.L    XCmdEntryPoint(A3),A0    ; get entry point addr
  428.         JSR        (A0)                    ; call HC
  429.         MOVE.L    4(SP),A0                ; ptr to result field
  430.         MOVE.L    XCmdOutArgs(A3),(A0)    ; set result
  431.         RTS                                ;
  432.  
  433. ZeroToExt
  434.         MOVE.L    xcmdBlockAddr(A6),A3    ; xcmd blk ptr
  435.         MOVE.L    8(SP),A0                ; handle to num string
  436.         MOVE.L    (A0),XCmdInArgs(A3)        ; ptr to num string
  437.         LEA.L    tempStr(A6),A0            ; pt to temp string area
  438.         MOVE.L    A0,XCmdInArgs+4(A3)        ; set temp string ptr
  439.         MOVE.W    #xreqZeroToPas,XCmdRequest(A3) ; convert to pascal string
  440.         MOVE.L    XCmdEntryPoint(A3),A0    ; get entry point addr
  441.         JSR        (A0)                    ; call HC
  442.         LEA.L    tempStr(A6),A0            ; pt to temp string area
  443.         MOVE.L    A0,XCmdInArgs(A3)        ; set first arg
  444.         LEA.L    tempX(A6),A0            ; pt to temp string area
  445.         MOVE.L    A0,XCmdInArgs+4(A3)        ; set first arg
  446.         MOVE.W    #xreqStrToExt,XCmdRequest(A3) ; set req code
  447.         MOVE.L    XCmdEntryPoint(A3),A0    ; get entry point addr
  448.         JSR        (A0)                    ; call HC
  449.         MOVE.L    4(SP),A0                ; ptr to result field
  450.         MOVE.W    tempX(A6),(A0)+            ; set result
  451.         CLR.W    (A0)+                    ; fill in the zeros
  452.         MOVE.L    tempX+2(A6),(A0)+        ; set result
  453.         MOVE.L    tempX+6(A6),(A0)+        ; set result
  454.         RTS                                ;
  455.  
  456.  
  457.             ENDWITH
  458.             ENDMAIN
  459.             END
  460.  
  461.